-- card: 2526 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: WritePermission
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XFCN,WritePermission,it
end Install


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=80 top=300 right=322 bottom=180
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Try It
----- HyperTalk script -----
on mouseUp
  get WritePermission(empty,true)
  if it is "Cancel" then exit mouseUp
  go to this card
  if it then answer "That file is available for writing."
  else answer "That file can’t be opened for writing."
end mouseUp



-- part 2 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part 3 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part contents for background part 16
----- text -----
WRITEPERMISSION XFCN version 1.1
Kevin Calhoun

WritePermission determines whether an existing file can be opened for writing as well as reading.  It is intended for developers who need to know whether HyperCard can obtain write permission for a stack before the stack is opened.  This knowledge is especially useful in shared environments.

INVOKING WRITEPERMISSION

get WritePermission(<fullPathName>,<checkResourceForkAlso>)

returns:  true if file can be opened for writing, false otherwise

WritePermission takes two optional parameters, the full pathname of a file and a flag to tell WritePermission to check the resource fork as well as the data fork of the file.  If no pathname is supplied, WritePermission will display a standard file dialog, out of which the user can select a file about which to inquire.

If the second parameter is "false", WritePermission returns "true" if the data fork of the file can be opened for writing, "false" otherwise.  If the second parameter is "true", WritePermission returns "true" if both the data fork and the resource fork of the file can be opened for writing, "false" otherwise.

2/20/90 version 1.1 works correctly with file servers.

-- part contents for card part 3
----- text -----
UNIT SecretStuffAboutTheFileManager;

{ XFCN WritePermission © 1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal WritePermission.p
Link -m ENTRYPOINT ∂
  -o "YourFile" ∂
  -rt XFCN=4125 ∂
  -sn Main=WritePermission ∂
  WritePermission.p.o ∂
  "{Libraries}"interface.o ∂
  "{PLibraries}"Paslib.o ∂
  "{Libraries}"HyperXLib.o
*)

INTERFACE
  USES
    Types,
    Resources,
    Dialogs,
    Packages,
    Files,
    ToolUtils,
    HyperXCmd;
  
  PROCEDURE EntryPoint(paramPtr: XCMDPtr);
  
IMPLEMENTATION

  PROCEDURE WritePermission(paramPtr: XCMDPtr); FORWARD;
  
  PROCEDURE EntryPoint(paramPtr: XCMDPtr);
  BEGIN
    WritePermission(paramPtr);
  END;
  
  FUNCTION GetScreenBitsBounds: Rect;
  { get screenbits.bounds from the QuickDraw globals }
  TYPE LongwordPtr = ^LONGINT;
       BitMapPtr = ^BitMap;
  CONST screenBitsOffset = -122;
        CurrentA5 = $904;
  VAR screenBitsPtr : BitMapPtr;
      myLongwordPtr : LongwordPtr;
  BEGIN
    myLongwordPtr := LongwordPtr(CurrentA5);
      { myLongwordPtr now points to the pointer to the first QD global }
    myLongwordPtr := LongwordPtr(myLongwordPtr^);
      { myLongwordPtr now points to the first QD global }
    screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
      { screenBitsPtr now points to the screenBits BitMap }
    GetScreenBitsBounds := screenBitsPtr^.bounds;
  END;

  PROCEDURE DoStandardFile(VAR reply: SFReply);
  VAR where : Point;
      typeList : SFTypeList;
      dlgt: DialogTHndl;
      r: rect;
      screen: rect;
      h,v: INTEGER;
  BEGIN  { select text file to read using SFGetFile }
    dlgt := DialogTHndl(GetResource('DLOG',getDlgID));
    IF dlgt = nil THEN SetPt(where,82,75)
    ELSE
      BEGIN
        r := dlgt^^.boundsRect;
        screen := GetScreenBitsBounds;
        h := ((screen.right - screen.left) - (r.right - r.left)) DIV 2;
        v := ((screen.bottom - screen.top) - (r.bottom - r.top)) DIV 2;
        SetPt(where,h,v);
      END;
    SFGetFile(where,'',NIL,-1,typeList,NIL,reply);
  END;
  
  PROCEDURE WritePermission(paramPtr: XCMDPtr);
  LABEL 8,9;
  VAR err: OSErr;
      reply: SFReply;
      fRefNum: INTEGER;
      fcbParams: FCBPBRec;
      hParamBlock: HParamBlockRec;
      volAttrib: INTEGER;
      fileAttrib: SignedByte;
      closeErr: INTEGER;
      str: Str255;
      canWrite: BOOLEAN;
  BEGIN
    IF paramPtr^.paramCount = 0 THEN DoStandardFile(reply)
    ELSE
      BEGIN
        ZeroToPas(paramPtr,paramPtr^.params[1]^,str);
        IF str = '' THEN DoStandardFile(reply)
        ELSE WITH reply DO
          BEGIN
            good := TRUE;
            vRefNum := 0;
            fName := str;
          END;
      END;
    IF NOT reply.good THEN
      BEGIN
        paramPtr^.returnValue := PasToZero(paramPtr,'Cancel');
        EXIT(WritePermission);
      END;
    
    canWrite := FALSE;                                   { assume failure }

    { Can the file be opened? }
    WITH reply DO err := FSOpen(fName,vRefNum,fRefNum);
    IF err <> noErr THEN GOTO 9;

    { Get the file control block info }
    ZeroBytes(paramPtr,@fcbParams,SIZEOF(fcbParams));
    fcbParams.ioRefNum := fRefNum;
    fcbParams.ioNamePtr := @str;
    err := PBGetFCBInfo(@fcbParams, FALSE);
    IF err <> noErr THEN GOTO 8;

    { Get the volume info }
    ZeroBytes(paramPtr,@hParamBlock,SIZEOF(hParamBlock));
    hParamBlock.ioVRefNum := fcbParams.ioFCBVRefNum;
    err := PBHGetVInfo(@hParamBlock,FALSE);
    IF err <> noErr THEN GOTO 8;
    volAttrib := hParamBlock.ioVAtrb;

    { Get the file info }
    ZeroBytes(paramPtr,@hParamBlock,SIZEOF(hParamBlock));
    hParamBlock.ioNamePtr := @str;
    hParamBlock.ioVRefNum := fcbParams.ioFCBVRefNum;
    hParamBlock.ioDirID := fcbParams.ioFCBParID;
    err := PBHGetFInfo(@hParamBlock,FALSE);
    IF err <> noErr THEN GOTO 8;
    fileAttrib := hParamBlock.ioFlAttrib;

{ We have write permission for this file if:
   bit 0 of the ioFCBFlags field of the FCB record is set (IM IV-180),
   the volume on which the file resides is not locked in hardware (IM IV-162,167),
   the volume on which the file resides is not locked in software (IM IV-162,167),
   and the file itself is not locked (IM IV-125). }

    canWrite := BTST(fcbParams.ioFCBFlags,8) &
                                          { fcb thinks writing is allowed }
                NOT BTST(volAttrib,7) &   { volume not locked in hardware }
                NOT BTST(volAttrib,15) &  { volume not locked in software }
                NOT BTST(fileAttrib,0);                 { file not locked }

    IF paramPtr^.paramCount > 1 THEN
      BEGIN     { if parameter 2 is TRUE, we check the resource fork also }
        ZeroToPas(paramPtr,paramPtr^.params[2]^,str);
        IF StrToBool(paramPtr,str)
        THEN canWrite := canWrite & NOT BTST(fileAttrib,2); { (IM IV-125) }
      END;

8:  closeErr := FSClose(fRefNum);
    canWrite := canWrite & (closeErr = noErr);

9:  BoolToStr(paramPtr,canWrite,str); 
    paramPtr^.returnValue := PasToZero(paramPtr,str);
  END;

END.